home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Source.zip / Initialize.p < prev    next >
Text File  |  1990-02-06  |  7KB  |  220 lines
  1. external;
  2.  
  3. {
  4.     Initialize.p (of PCQ Pascal)
  5.     Copyright (c) 1989 Patrick Quaid.
  6.  
  7.     This routine initializes all the global variables and
  8. enters the standard identifiers.
  9. }
  10.  
  11. {$O-}
  12. {$I "Pascal.i"}
  13.  
  14.     Function AddType(at_Object : TypeObject;
  15.              at_SubType: TypePtr;
  16.              at_Ref    : Address;
  17.              at_Upper,
  18.              at_Lower,
  19.              at_Size   : Integer) : TypePtr;
  20.         external;
  21.  
  22.     Function EnterStandard(    es_Name : String;
  23.                 es_Object : IDObject;
  24.                 es_Type : TypePtr;
  25.                 es_Storage : IDStorage;
  26.                 es_Offset : Integer) : IDPtr;
  27.         external;
  28.  
  29.     Function AllocString(l : integer): string;
  30.         external;
  31.  
  32.     Procedure NewBlock;
  33.         external;
  34.     Procedure NewSpell;
  35.         external;
  36.     
  37. Procedure InitStandard;
  38.  
  39. {
  40.     This is a huge routine, but since it's so straightforward I
  41. don't think I'll split it up.  It just enters all the standard
  42. identifiers into the identifier table.  Note that 'nil' is
  43. considered a standard identifier.
  44. }
  45. var
  46.     ID : IDPtr;
  47.     TP : TypePtr;
  48. begin
  49.     BadType := AddType(ob_ordinal, nil, nil, 0, 0, 4);
  50.  
  51.     IntType := AddType(ob_ordinal, nil, nil, 0, 0, 4);
  52.     ID := EnterStandard("Integer", obtype, IntType, st_none, 0);
  53.  
  54.     ShortType := AddType(ob_ordinal, nil, nil, 0, 0, 2);
  55.     ID := EnterStandard("Short", obtype, ShortType, st_none, 0);
  56.  
  57.     BoolType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  58.     ID := EnterStandard("Boolean", obtype, BoolType, st_none, 0);
  59.  
  60.     CharType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  61.     ID := EnterStandard("Char", obtype, CharType, st_none, 0);
  62.  
  63.     TextType := AddType(ob_file, CharType, nil, 0, 0, 32);
  64.     ID := EnterStandard("Text", obtype, TextType, st_none, 0);
  65.  
  66.     StringType := AddType(ob_pointer, CharType, nil, 0, 0, 4);
  67.     ID := EnterStandard("String", obtype, StringType, st_none, 0);
  68.  
  69.     RealType := AddType(ob_real, nil, nil, 0, 0, 4);
  70.     ID := EnterStandard("Real", obtype, RealType, st_none, 0);
  71.  
  72.     ByteType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  73.     ID := EnterStandard("Byte", obtype, ByteType, st_none, 0);
  74.  
  75.     AddressType := AddType(ob_pointer, BadType, nil, 0, 0, 4);
  76.     ID := EnterStandard("Address", obtype, AddressType, st_none, 0);
  77.  
  78.     LiteralType := AddType(ob_array, CharType, IntType, 1, 1, 1);
  79.  
  80.     ID := EnterStandard("Write", stanproc, nil, st_none, 1);
  81.     ID := EnterStandard("WriteLn", stanproc, nil, st_none, 2);
  82.     ID := EnterStandard("Read", stanproc, nil, st_none, 3);
  83.     ID := EnterStandard("ReadLn", stanproc, nil, st_none, 4);
  84.     ID := EnterStandard("New", stanproc, nil, st_none, 5);
  85.     ID := EnterStandard("Dispose", stanproc, nil, st_none, 6);
  86.     ID := EnterStandard("Close", stanproc, nil, st_none, 7);
  87.     ID := EnterStandard("Get", stanproc, nil, st_none, 8);
  88.     ID := EnterStandard("Exit", stanproc, nil, st_none, 9);
  89.     ID := EnterStandard("Trap", stanproc, nil, st_none, 10);
  90.     ID := EnterStandard("Put", stanproc, nil, st_none, 11);
  91.     ID := EnterStandard("Inc", stanproc, nil, st_none, 12);
  92.     ID := EnterStandard("Dec", stanproc, nil, st_none, 13);
  93.  
  94.     ID := EnterStandard("Ord", stanfunc, IntType, st_none, 1);
  95.     ID := EnterStandard("Chr", stanfunc, CharType, st_none, 2);
  96.     ID := EnterStandard("Odd", stanfunc, BoolType, st_none, 3);
  97.     ID := EnterStandard("Abs", stanfunc, IntType, st_none, 4);
  98.     ID := EnterStandard("Succ", stanfunc, IntType, st_none, 5);
  99.     ID := EnterStandard("Pred", stanfunc, IntType, st_none, 6);
  100.     ID := EnterStandard("Reopen", stanfunc, BoolType, st_none, 7);
  101.     ID := EnterStandard("Open", stanfunc, BoolType, st_none, 8);
  102.     ID := EnterStandard("EOF", stanfunc, BoolType, st_none, 9);
  103.     ID := EnterStandard("Trunc", stanfunc, IntType, st_none, 10);
  104.     ID := EnterStandard("Round", stanfunc, IntType, st_none, 11);
  105.     ID := EnterStandard("Float", stanfunc, RealType, st_none, 12);
  106.     ID := EnterStandard("Floor", stanfunc, RealType, st_none, 13);
  107.     ID := EnterStandard("Ceil", stanfunc, RealType, st_none, 14);
  108.     ID := EnterStandard("SizeOf", stanfunc, IntType, st_none, 15);
  109.     ID := EnterStandard("Adr", stanfunc, AddressType, st_none, 16);
  110.     ID := EnterStandard("Bit", stanfunc, IntType, st_none, 17);
  111.     ID := EnterStandard("Sqr", stanfunc, RealType, st_none, 18);
  112.     ID := EnterStandard("Sin", stanfunc, RealType, st_none, 19);
  113.     ID := EnterStandard("Cos", stanfunc, RealType, st_none, 20);
  114.  
  115.     ID := enterstandard("True", constant, BoolType, st_none, -1);
  116.     ID := enterstandard("False", constant, BoolType, st_none, 0);
  117.     ID := enterstandard("MaxInt", constant, IntType, st_none, $7FFFFFFF);
  118.     ID := enterstandard("MaxShort", constant, ShortType, st_none, $7FFF);
  119.     ID := enterstandard("Nil", constant, AddressType, st_none, 0);
  120.  
  121.     ID := EnterStandard("CommandLine", global, StringType, st_external, 0);
  122.     ID := EnterStandard("ExitProc", global, AddressType, st_external, 0);
  123.     ID := EnterStandard("ExitCode", global, IntType, st_external, 0);
  124.     ID := EnterStandard("ExitAddr", global, AddressType, st_external, 0);
  125.     ID := EnterStandard("IOResult", func, IntType, st_external, 0);
  126.     ID := EnterStandard("Input", global, TextType, st_external, 0);
  127.     ID := EnterStandard("Output", global, TextType, st_external, 0);
  128. end;
  129.  
  130.  
  131. Procedure InitReserved();
  132.  
  133. {
  134.     This initializes the array of reserved words.  If you mess
  135. around with this, be advised that the symbol numbers defined in
  136. pasconst.i correspond with the indices of these words.  Look at
  137. searchreserved in utilities.p to explain the previous sentence.
  138. }
  139.  
  140. begin
  141.     Reserved[And1]    := "AND";
  142.     Reserved[Array1]    := "ARRAY";
  143.     Reserved[Begin1]    := "BEGIN";
  144.     Reserved[By1]    := "BY";
  145.     Reserved[Case1]    := "CASE";
  146.     Reserved[Const1]    := "CONST";
  147.     Reserved[Div1]    := "DIV";
  148.     Reserved[Do1]    := "DO";
  149.     Reserved[Downto1]    := "DOWNTO";
  150.     Reserved[Else1]    := "ELSE";
  151.     Reserved[End1]    := "END";
  152.     Reserved[Extern1]    := "EXTERNAL";
  153.     Reserved[File1]    := "FILE";
  154.     Reserved[For1]    := "FOR";
  155.     Reserved[Forward1]    := "FORWARD";
  156.     Reserved[Func1]    := "FUNCTION";
  157.     Reserved[Goto1]    := "GOTO";
  158.     Reserved[If1]    := "IF";
  159.     Reserved[In1]    := "IN";
  160.     Reserved[Label1]    := "LABEL";
  161.     Reserved[Mod1]    := "MOD";
  162.     Reserved[Not1]    := "NOT";
  163.     Reserved[Of1]    := "OF";
  164.     Reserved[Or1]    := "OR";
  165.     Reserved[Packed1]    := "PACKED";
  166.     Reserved[Private1]    := "PRIVATE";
  167.     Reserved[Proc1]    := "PROCEDURE";
  168.     Reserved[Program1]    := "PROGRAM";
  169.     Reserved[Record1]    := "RECORD";
  170.     Reserved[Repeat1]    := "REPEAT";
  171.     Reserved[Return1]    := "RETURN";
  172.     Reserved[Set1]    := "SET";
  173.     Reserved[Shl1]    := "SHL";
  174.     Reserved[Shr1]    := "SHR";
  175.     Reserved[Then1]    := "THEN";
  176.     Reserved[To1]    := "TO";
  177.     Reserved[Type1]    := "TYPE";
  178.     Reserved[Until1]    := "UNTIL";
  179.     Reserved[Var1]    := "VAR";
  180.     Reserved[While1]    := "WHILE";
  181.     Reserved[With1]    := "WITH";
  182.     Reserved[Xor1]    := "XOR";
  183. end;
  184.  
  185. Procedure InitGlobals;
  186.  
  187. {
  188.     This just puts the startup values into the variables.
  189. }
  190.  
  191. begin
  192.     litlab := 1;
  193.  
  194.     symtext := allocstring(80);
  195.  
  196.     eqstart := 0;
  197.     eqend := 0;
  198.     errorptr := 0;
  199.  
  200.     LitPtr := 0;
  201.     SpellPtr := 0;
  202.     NewSpell;
  203.     errorcount := 0;
  204.     lineno := 1;
  205.     FirstWith := Nil;
  206.     StackLoad := 0;
  207.     currsym := Unknown1;
  208.     symloc := 0;
  209.     currfn := Nil;
  210.     TypeID := Nil;
  211.     nxtlab := 1;
  212.     CharBuffed := False;
  213.     RangeCheck := false;
  214.     IOCheck := True;
  215.     Inform := True;
  216.     IncludeList := Nil;
  217.     CurrentBlock := Nil;
  218.     NewBlock;
  219. end;
  220.